03_CLS_Spend_Response_Curves_No_Poly

Use Dataset created from 02_CLS_Data_Summary_2022_0914_Data_Analysis File

Loading Data

Load Google Sheet

Final_CLS_2022_Study_List_Non_Search_model_file <- read_sheet(
  "https://docs.google.com/spreadsheets/d/1N48rTeq7md0v8w8pG_8XIiuapPHQAeO5WoWIB3eaceI/edit#gid=1449351377",
  sheet = "FinalDataset_2022_Update"
) %>%
  mutate(
    Significant_Spend =
      as.numeric(
        case_when(
          probability_of_lift >= 0.9 ~ 1,
          TRUE ~ 0
        )
      ),
    country = case_when(
      country == "NA" ~ "US",
      TRUE ~ country
    ),
    region_v2 = case_when(
      country == "US" ~ "NA",
      country == "CA" ~ "NA",
      country == "US + CA" ~ "NA",
      TRUE ~ region
    )
  ) %>%
  filter(channel != "Search") %>%
  # filter out studies without reported lifts
  filter(exposed != -1) %>%
  # filter out google pay study
  filter(study_id != "149142217") %>%
  # filter out very negative absolute lifts
  filter(absolute_lift > -1000) %>%
  mutate(
    pa = case_when(
      pa == "Google Ads" ~ "SMB", # Step 1
      pa == "YouTube" & conversion != "Type 256522942 ([MCC] YouTube TV - Web - Trial Start)" ~ "YTMP", # Step 2
      pa == "YouTube Premium" ~ "YTMP", # Step 2
      conversion == "Type 256522942 ([MCC] YouTube TV - Web - Trial Start)" ~ "YouTube TV", # Step 2
      pa == "Cloud" & conversion != "Type 14257803 (Enterprise - Apps - Signup Confirm - Unique)" ~ "Cloud Workspace", # Step 3
      pa == "Cloud" & conversion == "Type 14257803 (Enterprise - Apps - Signup Confirm - Unique)" ~ "Cloud GCP", # Step 3
      pa == "Project Fi" ~ "Google Fi", # Step 4
      pa == "Google Chrome" ~ "Chrome",
      TRUE ~ pa
    )
  ) %>%
  mutate(
    parsed_type = parse_number(conversion),
    grouped_conversion = case_when(
      conversion %in% c("Chromebook Microsite Referral Clicks Q4 2015", "Type 251422729 (Chromebooks Microsite Referral Clicks (Q4 2017))") ~ "Chromebook Referrals",
      conversion %in% c("Desktop Downloads", "Type 11541547 (Desktop Download)") ~
        "Desktop Downloads",
      pa == "Pixel" ~ "Mobile Conversions",
      pa == "DSM" ~ "Non-Mobile Device Conversions",
      conversion == "Type 302982954 (Lena - P Lead)" ~ "Lena P Lead",
      conversion == "Type 288347008 (LENA - B Lead)" ~ "Lena B Lead",
      conversion == "Type 288697653 (LENA - Q Lead)" ~ "Lena Q Lead",
      parsed_type %in% c(181283993, 855508686) ~ "Workspace Free Trial Start",
      parsed_type == 330755641 ~ "Microsite Conversions",
      parsed_type == 14257803 ~ "Enterprise Signups",
      parsed_type == 289680712 ~ "Google(iOs) First Open",
      parsed_type == 256522942 ~ "YouTube TV - Web - Trial Start",
      parsed_type %in% c(452391534, 221497833, 277150074) ~ "Trial Signups Complete",
      TRUE ~ conversion
    ),
    pa = case_when(
      conversion == "Type 288697653 (LENA - Q Lead)" ~ "SMB-QLead",
      TRUE ~ pa
    )
  ) %>%
  filter(absolute_lift > 0)


# all.equal(Final_CLS_2022_Study_List_Non_Search_model_file,Final_CLS_2022_Study_List_Non_Search_v3)

Create All Response Curves only normal powers

Folder for all Output and scripts

file.sources <- list.files(path = "RScripts/", pattern = "*.R", full.names = TRUE)
sapply(file.sources, source, .GlobalEnv)

        RScripts/best_ind_function.R RScripts/export_rplots_function.R RScripts/export_rplots_function2.R
value   ?                            ?                                 ?                                 
visible FALSE                        FALSE                             FALSE                             
        RScripts/graphing_function.R RScripts/graphing_function_elasticnet.R RScripts/graphing_function_rlm.R
value   ?                            ?                                       ?                               
visible FALSE                        FALSE                                   FALSE                           
        RScripts/graphing_function2.R RScripts/graphing_function3.R RScripts/graphing_function4.R
value   ?                             ?                             ?                            
visible FALSE                         FALSE                         FALSE                        
        RScripts/graphing_function4_w_anom.R RScripts/model_wrapper_function.R RScripts/model_wrapper_function2.R
value   ?                                    ?                                 ?                                 
visible FALSE                                FALSE                             FALSE                             
        RScripts/named_group_split.R RScripts/names_function.R RScripts/ridge_lasso_function.R RScripts/ridge_lasso_function2.R
value   ?                            ?                         ?                               ?                               
visible FALSE                        FALSE                     FALSE                           FALSE                           
        RScripts/ridge_lasso_function4.R RScripts/rlm_function.R RScripts/rlm_function2.R
value   ?                                ?                       ?                       
visible FALSE                            FALSE                   FALSE                   

Check parameters

### powers to try
powers <- seq(0.1, 0.9, by = 0.01)
powers2 <- 1

### Powers to Try
#powers <- seq(0.1, 0.9, by = 0.01)
#powers2 <-seq(1.5,3, by = 0.25)


### Lambda parameters
parameters <- c(
  #  seq(0.1, 2, by =0.1) ,  seq(2, 5, 0.5) ,
  seq(5, 29, 1)
  ,seq(30, 102, 4)
  ,seq(110, 1000, 15)
  ,seq(1000, 10020, 500)
)

### elasticnet parameters
alpha_parameters <- c(seq(0, 1, 0.25))

# For Testing Purposes
#alpha_parameters <- c(seq(1, 1, 1))

Testing Different Model Types

Chrome

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_chrome_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(pa == "Chrome") %>%
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_chrome_pre %>%
  select(
    region_v2, country, channel, tactic,
    cost_spent_on_exposed_group:absolute_lift
  )

iso_chrome <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1153)

iso_chrome$fit(df_test)

scores_train <- df_test %>%
  iso_chrome$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_chrome_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_chrome_pre %>%
  left_join(scores_train, by = c("id2" = "id")) %>% 
  filter(average_depth > 3)


Final_CLS_2022_Study_List_Non_Search_model_file_chrome <-
  Final_CLS_2022_Study_List_Non_Search_model_file_chrome_pre2 %>%
  named_group_split(tactic)

Run Model

fits_non_search_chrome <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_chrome,poly_ind = 0)

best_ind_non_search_chrome <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_chrome), best_ind_function,df = fits_non_search_chrome,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_chrome) 

coef_non_search_chrome <- best_ind_non_search_chrome %>% bind_rows #make a matrix of all coefs

best_fit_non_search_chrome <- best_ind_non_search_chrome %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_chrome_pre, tactic))  

Create Graph Object

graph_list_chrome <- lapply(1:length(best_fit_non_search_chrome), graphing_function4, df1 = best_fit_non_search_chrome, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_chrome)

end_time <- Sys.time()

time_chrome = end_time - start_time

time_chrome

Cloud

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_cloud_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(pa %in% c("Cloud GCP", "Cloud Workspace")) %>%
  mutate(
    pa = "Cloud",
    pa2 = "Cloud - All Channel"
  ) %>%
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_cloud_pre %>%
  # select(-study_id, -id2, -region, -scaling_factor, -quarter, -pa, -study_name)
  select(
    region_v2, country, channel, tactic,
    # treatment_user_count:control,
    cost_spent_on_exposed_group:absolute_lift, parsed_type
  )

iso_cloud <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1153)

iso_cloud$fit(df_test)

scores_train <- df_test %>%
  iso_cloud$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_cloud_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_cloud_pre %>%
  left_join(scores_train, by = c("id2" = "id"))

Final_CLS_2022_Study_List_Non_Search_model_file_cloud <-
  Final_CLS_2022_Study_List_Non_Search_model_file_cloud_pre2 %>%
  named_group_split(pa2)

Run Model

fits_non_search_cloud <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_cloud,poly_ind = 0)

best_ind_non_search_cloud <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_cloud), best_ind_function,df = fits_non_search_cloud,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_cloud) 

coef_non_search_cloud <- best_ind_non_search_cloud %>% bind_rows #make a matrix of all coefs

best_fit_non_search_cloud <- best_ind_non_search_cloud %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_cloud_pre, pa2))  

Create Graph Object

graph_list_cloud <- lapply(1:length(best_fit_non_search_cloud), graphing_function4, df1 = best_fit_non_search_cloud, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_cloud)

end_time <- Sys.time()

time_cloud = end_time - start_time

YouTube

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_youtube_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(pa %in% c("YouTube TV", "YTMP")) %>%
  mutate(
    pa = "YouTube",
    pa2 = "YouTube"
  ) %>%
  #  filter(absolute_lift < 5000) %>%
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_youtube_pre %>%
  # select(-study_id, -id2, -region, -scaling_factor, -quarter, -pa, -study_name)
  select(
    region_v2, country, channel, tactic,
    # treatment_user_count:control,
    cost_spent_on_exposed_group:absolute_lift, parsed_type
  )

iso_yt <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1153)

iso_yt$fit(df_test)

scores_train <- df_test %>%
  iso_yt$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_youtube_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_youtube_pre %>%
  left_join(scores_train, by = c("id2" = "id")) %>%
  filter(average_depth > 3.89)

Final_CLS_2022_Study_List_Non_Search_model_file_youtube <-
  Final_CLS_2022_Study_List_Non_Search_model_file_youtube_pre2 %>%
  named_group_split(region_v2)

Run Model

fits_non_search_youtube <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_youtube,poly_ind = 0)

best_ind_non_search_youtube <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_youtube), best_ind_function,df = fits_non_search_youtube,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_youtube) 

coef_non_search_youtube <- best_ind_non_search_youtube %>% bind_rows #make a matrix of all coefs

best_fit_non_search_youtube <- best_ind_non_search_youtube %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_youtube_pre, pa2))  

Create Graph Object

graph_list_youtube <- lapply(1:length(best_fit_non_search_youtube), graphing_function4, df1 = best_fit_non_search_youtube, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_youtube)

end_time <- Sys.time()

time_youtube = end_time - start_time

DSM

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_dsm_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(pa == "DSM") %>%
  filter(region_v2 != "APAC") %>%
  # filter(absolute_lift < 1000) # %>%
  # filter(study_id != '6297420') #%>%
  #  filter(study_id !='149161711') %>%
  #  filter(study_id != '148613002') %>%
  # filter(study_id !='3284625') %>%
  #  filter(study_id !='3329131')
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_dsm_pre %>%
  # select(-study_id, -id2, -region, -scaling_factor, -quarter, -pa, -study_name)
  select(
    region_v2, country, channel, tactic,
    # treatment_user_count:control,
    cost_spent_on_exposed_group:absolute_lift
  )

iso_dsm <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1152)

iso_dsm$fit(df_test)

scores_train <- df_test %>%
  iso_dsm$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_dsm_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_dsm_pre %>%
  left_join(scores_train, by = c("id2" = "id")) %>%
  filter(average_depth > 5)

Final_CLS_2022_Study_List_Non_Search_model_file_dsm <-
  Final_CLS_2022_Study_List_Non_Search_model_file_dsm_pre2 %>%
  named_group_split(region_v2, channel)

Run Model

fits_non_search_dsm <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_dsm,poly_ind = 0)

best_ind_non_search_dsm <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_dsm), best_ind_function,df = fits_non_search_dsm,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_dsm)

coef_non_search_dsm <- best_ind_non_search_dsm %>% bind_rows #make a matrix of all coefs

best_fit_non_search_dsm <- best_ind_non_search_dsm %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_dsm_pre, region_v2,channel))  

Create Graph Object

graph_list_dsm <- lapply(1:length(best_fit_non_search_dsm), graphing_function4, df1 = best_fit_non_search_dsm, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_dsm)

end_time <- Sys.time()

time_dsm = end_time - start_time

Pixel

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_pixel_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(pa == "Pixel") %>%
  mutate(
    pa2 = "Pixel - All Channel"
  ) %>%
  #   filter(absolute_lift < 1000)  %>%
  # filter(study_id != '6297420') #%>%
  #  filter(study_id !='149161711') %>%
  #  filter(study_id != '148613002') %>%
  # filter(study_id !='3284625') %>%
  #  filter(study_id !='3329131')
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_pixel_pre %>%
  # select(-study_id, -id2, -region, -scaling_factor, -quarter, -pa, -study_name)
  select(
    region_v2, country, channel, tactic,
    # treatment_user_count:control,
    cost_spent_on_exposed_group:absolute_lift
  )

iso_pixel <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1152)

iso_pixel$fit(df_test)

scores_train <- df_test %>%
  iso_pixel$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_pixel_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_pixel_pre %>%
  left_join(scores_train, by = c("id2" = "id")) %>%
  filter(average_depth > 3.1)

Final_CLS_2022_Study_List_Non_Search_model_file_pixel_pre2


Final_CLS_2022_Study_List_Non_Search_model_file_pixel <-
  Final_CLS_2022_Study_List_Non_Search_model_file_pixel_pre2 %>%
  named_group_split(pa2)

Run Model

fits_non_search_pixel <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_pixel,poly_ind = 0)

best_ind_non_search_pixel <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_pixel), best_ind_function,df = fits_non_search_pixel,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_pixel) 

coef_non_search_pixel <- best_ind_non_search_pixel %>% bind_rows #make a matrix of all coefs

best_fit_non_search_pixel <- best_ind_non_search_pixel %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_pixel_pre, pa2))  

Create Graph Object

graph_list_pixel <- lapply(1:length(best_fit_non_search_pixel), graphing_function4, df1 = best_fit_non_search_pixel, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_pixel)

end_time <- Sys.time()

time_pixel = end_time - start_time

Fi

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_fi_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(pa == "Google Fi") %>%
  mutate(
    pa2 = "Fi - All Channel"
  ) %>%
  #   filter(absolute_lift < 1000)  %>%
  # filter(study_id != '6297420') #%>%
  #  filter(study_id !='149161711') %>%
  #  filter(study_id != '148613002') %>%
  # filter(study_id !='3284625') %>%
  #  filter(study_id !='3329131')
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_fi_pre %>%
  # select(-study_id, -id2, -region, -scaling_factor, -quarter, -pa, -study_name)
  select(
    region_v2, country, channel, tactic,
    # treatment_user_count:control,
    cost_spent_on_exposed_group:absolute_lift
  )

iso_fi <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1152)

iso_fi$fit(df_test)

scores_train <- df_test %>%
  iso_fi$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_fi_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_fi_pre %>%
  left_join(scores_train, by = c("id2" = "id")) %>%
  filter(average_depth > 4.75)

Final_CLS_2022_Study_List_Non_Search_model_file_fi_pre2


Final_CLS_2022_Study_List_Non_Search_model_file_fi <-
  Final_CLS_2022_Study_List_Non_Search_model_file_fi_pre2 %>%
  named_group_split(channel)

Run Model

fits_non_search_fi <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_fi,poly_ind = 0)

best_ind_non_search_fi <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_fi), best_ind_function,df = fits_non_search_fi,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_fi) 

coef_non_search_fi <- best_ind_non_search_fi %>% bind_rows #make a matrix of all coefs

best_fit_non_search_fi <- best_ind_non_search_fi %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_fi_pre, pa2))  

Create Graph Object

graph_list_fi <- lapply(1:length(best_fit_non_search_fi), graphing_function4, df1 = best_fit_non_search_fi, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_fi)

end_time <- Sys.time()

time_fi = end_time - start_time

SMB - QLeads

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_smbq_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(grouped_conversion == 'Lena Q Lead') %>%
  mutate(
    pa2 = "SMB - Q-Lead"
  ) %>%
  #   filter(absolute_lift < 1000)  %>%
  # filter(study_id != '6297420') #%>%
  #  filter(study_id !='149161711') %>%
  #  filter(study_id != '148613002') %>%
  # filter(study_id !='3284625') %>%
  #  filter(study_id !='3329131')
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_smbq_pre %>%
  # select(-study_id, -id2, -region, -scaling_factor, -quarter, -pa, -study_name)
  select(
    region_v2, country, channel, tactic,
    # treatment_user_count:control,
    cost_spent_on_exposed_group:absolute_lift
  )

iso_smbq <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1152)

iso_smbq$fit(df_test)

scores_train <- df_test %>%
  iso_smbq$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_smbq_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_smbq_pre %>%
  left_join(scores_train, by = c("id2" = "id")) %>% 
  filter(average_depth > 1)

Final_CLS_2022_Study_List_Non_Search_model_file_smbq <-
  Final_CLS_2022_Study_List_Non_Search_model_file_smbq_pre2 %>%
  named_group_split(pa2)

Run Model

fits_non_search_smbq <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_smbq,poly_ind = 0)

best_ind_non_search_smbq <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_smbq), best_ind_function,df = fits_non_search_smbq,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_smbq) 

coef_non_search_smbq <- best_ind_non_search_smbq %>% bind_rows #make a matrix of all coefs

best_fit_non_search_smbq <- best_ind_non_search_smbq %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_smbq_pre, pa2))  

Create Graph Object

graph_list_smbq <- lapply(1:length(best_fit_non_search_smbq), graphing_function4, df1 = best_fit_non_search_smbq, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_smbq)

end_time <- Sys.time()

time_smbq = end_time - start_time

SMB - BLeads

Data Readin

start_time <- Sys.time()

Final_CLS_2022_Study_List_Non_Search_model_file_smbb_pre <-
  Final_CLS_2022_Study_List_Non_Search_model_file %>%
  filter(pa == "SMB" & grouped_conversion == 'Lena B Lead') %>%
  mutate(
    pa2 = "SMB - B-Lead"
  ) %>%
  #   filter(absolute_lift < 1000)  %>%
  # filter(study_id != '6297420') #%>%
  #  filter(study_id !='149161711') %>%
  #  filter(study_id != '148613002') %>%
  # filter(study_id !='3284625') %>%
  #  filter(study_id !='3329131')
  mutate(
    id2 = row_number()
  )

df_test <-
  Final_CLS_2022_Study_List_Non_Search_model_file_smbb_pre %>%
  # select(-study_id, -id2, -region, -scaling_factor, -quarter, -pa, -study_name)
  select(
    region_v2, country, channel, tactic,
    # treatment_user_count:control,
    cost_spent_on_exposed_group:absolute_lift
  )

iso_smbb <- isolationForest$new(sample_size = nrow(df_test), num_trees = 10000, seed = 1152)

iso_smbb$fit(df_test)

scores_train <- df_test %>%
  iso_smbb$predict() %>%
  arrange(desc(anomaly_score))

Final_CLS_2022_Study_List_Non_Search_model_file_smbb_pre2 <-
  Final_CLS_2022_Study_List_Non_Search_model_file_smbb_pre %>%
  left_join(scores_train, by = c("id2" = "id")) %>% 
  filter(average_depth > 4)

Final_CLS_2022_Study_List_Non_Search_model_file_smbb <-
  Final_CLS_2022_Study_List_Non_Search_model_file_smbb_pre2 %>%
  named_group_split(channel)

Run Model

fits_non_search_smbb <- model_wrapper_function(df = Final_CLS_2022_Study_List_Non_Search_model_file_smbb,poly_ind = 0)

best_ind_non_search_smbb <- 
  lapply(1:length(Final_CLS_2022_Study_List_Non_Search_model_file_smbb), best_ind_function,df = fits_non_search_smbb,
         df2 = Final_CLS_2022_Study_List_Non_Search_model_file_smbb) 

coef_non_search_smbb <- best_ind_non_search_smbb %>% bind_rows #make a matrix of all coefs

best_fit_non_search_smbb <- best_ind_non_search_smbb %>%
  set_names(names_function(Final_CLS_2022_Study_List_Non_Search_model_file_smbb_pre, channel))  

Create Graph Object

graph_list_smbb <- lapply(1:length(best_fit_non_search_smbb), graphing_function4, df1 = best_fit_non_search_smbb, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_smbb)

end_time <- Sys.time()

time_smbb = end_time - start_time

Export all graph lists

graph_names <- mget(ls(pat = 'graph_list_'))
   
df_names <- mget(setdiff(ls(pattern = 'Final_CLS_2022_Study_List_Non_Search_model_file_'), ls(pattern = "pre")))

#rm(Final_CLS_2022_Study_List_Non_Search_model_file_Chrome,Final_CLS_2022_Study_List_Non_Search_model_file_Cloud,Final_CLS_2022_Study_List_Non_Search_model_file_YouTube)

#lapply(1:length(graph_names),
#      function(j) {
#lapply(1:length(df_names[[j]]),export_rplots_function2,starting_name = "Non_Search_",folder_name = folder_name,df_list = #df_names[[j]],graphing_list = graph_names[j][[1]])
#      }
#       )

Grid of all Response Curves

Sub Plot Documentation

Coef Matrix

Graphs with Anomaly Scores

graph_list.fi <- lapply(1:length(best_fit_non_search_fi), graphing_function4_w_anom, df1 = best_fit_non_search_fi, df2 = Final_CLS_2022_Study_List_Non_Search_model_file_fi)

### Add GG Text Repel
ggplotly(graph_list.fi[[3]])

Create all Response Curves - Ridge/Lasso

start_time <- Sys.time()

fits.non.search.RIDGE_LASSO <- lapply(
  1:length(df_names),
  function(i) {
    model_wrapper_function(df = df_names[i][[1]],poly_ind = 0)
  }
)

Create all Response Curves - RLM

start_time <- Sys.time()

fits.non.search.RLM <- lapply(
  1:length(df_names),
  function(i) {
    model_wrapper_function2(df = df_names[i][[1]])
  }
)

end_time <- Sys.time()

combined_rlm_time <- start_time - end_time

best.ind.non.search.RLM <- lapply(
  1:length(df_names),
  function(i) {   
  lapply(1:length(df_names[i][[1]]), best_ind_function,df = fits.non.search.RLM[i][[1]],
         df2 = df_names[i][[1]])
  }
)

coef.non.search.RLM <- lapply(
  1:length(df_names),
  function (i){
  best.ind.non.search.RLM[i][[1]] %>% bind_rows
  }
) %>%
  bind_rows() %>% 
  as.data.frame() %>% 
  mutate(
    cost_p2 = 0,
    lambda = 0,
    alpha = 0,
    powers2 = 0
  ) %>% 
  select(one_of(colnames(coef.2_matrix)))


best.fit.non.search.RLM <- lapply(1:length(df_names),
      function(j) {
lapply(1:length(best.ind.non.search.RLM[[j]]),
      function(i){
        best.ind.non.search.RLM[j][[1]][i] %>% 
        set_names(nm = best.ind.non.search.RLM[j][[1]][[i]]["model"])
      } 
)
      }
       )


  

-combined_ridge_time+combined_rlm_time

Time difference of 32.768 mins

graph.list.rlm <- lapply(1:length(df_names),
      function(i){
      lapply(1:length(best.fit.non.search.RLM[i][[1]]), graphing_function_rlm, df1= best.fit.non.search.RLM[i],df2 = df_names[i])
      } 
)


graph.list.RIDGE_LASSO <- lapply(1:length(df_names),
      function(i){
      lapply(1:length(best.fit.non.search.RIDGE_LASSO[i][[1]]), graphing_function_elasticnet, df1= best.fit.non.search.RIDGE_LASSO[i],df2 = df_names[i])
      } 
)

Export all Plots

folder_name1 <- paste0("Output/", "outputfiles_", Sys.Date(), "_", "RLM", "/")
dir.create(folder_name1) # it will throw a warning if folder exists

Warning in dir.create(folder_name1) :
  'Output\outputfiles_2022-11-08_RLM' already exists

lapply(1:length(df_names),
      function(j) {
lapply(1:length(df_names[[j]]),export_rplots_function2,starting_name = "Non_Search_",folder_name = folder_name1,df_list = df_names[[j]],graphing_list = graph.list.rlm[j][[1]])
      }
       )

Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image

[[1]]
[[1]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Chrome_All_Channel.png"

[[1]][[2]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Chrome_non-REMK.png"

[[1]][[3]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Chrome_REMK.png"


[[2]]
[[2]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Cloud_Cloud_-_All_Channel.png"


[[3]]
[[3]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_DSM_EMEA__DISCOVERY.png"

[[3]][[2]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_DSM_EMEA__DISPLAY.png"

[[3]][[3]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_DSM_EMEA__YOUTUBE.png"

[[3]][[4]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_DSM_NA__DISCOVERY.png"

[[3]][[5]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_DSM_NA__DISPLAY.png"

[[3]][[6]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_DSM_NA__YOUTUBE.png"


[[4]]
[[4]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Google_Fi_DISCOVERY.png"

[[4]][[2]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Google_Fi_DISPLAY.png"

[[4]][[3]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Google_Fi_YOUTUBE.png"


[[5]]
[[5]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_Pixel_Pixel_-_All_Channel.png"


[[6]]
[[6]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_SMB_DISCOVERY.png"

[[6]][[2]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_SMB_DISPLAY.png"

[[6]][[3]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_SMB_YOUTUBE.png"


[[7]]
[[7]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_SMB-QLead_SMB_-_Q-Lead.png"


[[8]]
[[8]][[1]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_YouTube_APAC.png"

[[8]][[2]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_YouTube_EMEA.png"

[[8]][[3]]
[1] "Output/outputfiles_2022-11-08_RLM/Non_Search_YouTube_NA.png"

folder_name2 <- paste0("Output/", "outputfiles_", Sys.Date(), "_", "ElasticNet", "/")
dir.create(folder_name2) # it will throw a warning if folder exists

Warning in dir.create(folder_name2) :
  'Output\outputfiles_2022-11-08_ElasticNet' already exists

lapply(1:length(df_names),
      function(j) {
lapply(1:length(df_names[[j]]),export_rplots_function2,starting_name = "Non_Search_",folder_name = folder_name2,df_list = df_names[[j]],graphing_list = graph.list.RIDGE_LASSO[j][[1]])
      }
       )

Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image
Saving 18.8 x 12.5 in image

[[1]]
[[1]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Chrome_All_Channel.png"

[[1]][[2]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Chrome_non-REMK.png"

[[1]][[3]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Chrome_REMK.png"


[[2]]
[[2]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Cloud_Cloud_-_All_Channel.png"


[[3]]
[[3]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_DSM_EMEA__DISCOVERY.png"

[[3]][[2]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_DSM_EMEA__DISPLAY.png"

[[3]][[3]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_DSM_EMEA__YOUTUBE.png"

[[3]][[4]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_DSM_NA__DISCOVERY.png"

[[3]][[5]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_DSM_NA__DISPLAY.png"

[[3]][[6]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_DSM_NA__YOUTUBE.png"


[[4]]
[[4]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Google_Fi_DISCOVERY.png"

[[4]][[2]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Google_Fi_DISPLAY.png"

[[4]][[3]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Google_Fi_YOUTUBE.png"


[[5]]
[[5]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_Pixel_Pixel_-_All_Channel.png"


[[6]]
[[6]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_SMB_DISCOVERY.png"

[[6]][[2]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_SMB_DISPLAY.png"

[[6]][[3]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_SMB_YOUTUBE.png"


[[7]]
[[7]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_SMB-QLead_SMB_-_Q-Lead.png"


[[8]]
[[8]][[1]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_YouTube_APAC.png"

[[8]][[2]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_YouTube_EMEA.png"

[[8]][[3]]
[1] "Output/outputfiles_2022-11-08_ElasticNet/Non_Search_YouTube_NA.png"

Show Graphs

lapply(1:length(df_names),
function(j){
  subplot(graph.list.rlm[j][[1]], nrows = length(graph.list.rlm[j][[1]]))
}
)

[[1]]

[[2]]

[[3]]

[[4]]

[[5]]

[[6]]

[[7]]

[[8]]

lapply(1:length(df_names),
function(i){
#p1 = graph_names[i][[1]]
do.call(grid.arrange,graph.list.rlm[i][[1]])
#return(grid.arrange(grobs = p1))
}
)

[[1]]
TableGrob (3 x 1) "arrange": 3 grobs

[[2]]
TableGrob (1 x 1) "arrange": 1 grobs

[[3]]
TableGrob (3 x 2) "arrange": 6 grobs

[[4]]
TableGrob (3 x 1) "arrange": 3 grobs

[[5]]
TableGrob (1 x 1) "arrange": 1 grobs

[[6]]
TableGrob (3 x 1) "arrange": 3 grobs

[[7]]
TableGrob (1 x 1) "arrange": 1 grobs

[[8]]
TableGrob (3 x 1) "arrange": 3 grobs

NA

lapply(1:length(df_names),
function(j){
  subplot(graph.list.RIDGE_LASSO[j][[1]], nrows = length(graph.list.RIDGE_LASSO[j][[1]]))
}
)

[[1]]

[[2]]

[[3]]

[[4]]

[[5]]

[[6]]

[[7]]

[[8]]

lapply(1:length(df_names),
function(i){
#p1 = graph_names[i][[1]]
do.call(grid.arrange,graph.list.RIDGE_LASSO[i][[1]])
#return(grid.arrange(grobs = p1))
}
)

[[1]]
TableGrob (3 x 1) "arrange": 3 grobs

[[2]]
TableGrob (1 x 1) "arrange": 1 grobs

[[3]]
TableGrob (3 x 2) "arrange": 6 grobs

[[4]]
TableGrob (3 x 1) "arrange": 3 grobs

[[5]]
TableGrob (1 x 1) "arrange": 1 grobs

[[6]]
TableGrob (3 x 1) "arrange": 3 grobs

[[7]]
TableGrob (1 x 1) "arrange": 1 grobs

[[8]]
TableGrob (3 x 1) "arrange": 3 grobs

NA